home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 090 / vmap.arc / VMAP.BAS next >
Encoding:
BASIC Source File  |  1980-01-03  |  6.9 KB  |  173 lines
  1. 10 'VMAP.BAS VERSION 1.0
  2. 11 '
  3. 12 '
  4. 13 '
  5. 14 '--------------------------------------------------------------
  6. 20 'BATCH BUILD SEGMENT, 07/26/81, JWC
  7. 30 '
  8. 40 '
  9. 50 CL$=CHR$(30)+CHR$(27)+CHR$(89)'CLEAR SCREEN CODE FOR ACTRIX COMPUTER
  10. 60 FF$=CHR$(12)'FORMFEED CODE FOR CENTRONICS PRINTERS
  11. 70 '
  12. 80 '
  13. 90 PRINT CL$
  14. 100 INPUT "PROCESS LAST SETUP (Y/N) ";TI$:IF TI$="Y" THEN GOTO 170
  15. 105 PRINT
  16. 110 OPEN "O",#1,"A:VARDAT"
  17. 120 INPUT"FILE NAME, TERMINATOR, LOWER BOUND, UPPER BOUND ";PN$,TI$,LB!,UB!
  18. 130 PRINT#1,CHR$(34);PN$;CHR$(34);CHR$(34);TI$;CHR$(34);LB!,UB!
  19. 140 IF TI$="END" THEN GOTO 160
  20. 150 GOTO 120
  21. 160 CLOSE 1
  22. 161 '
  23. 162 '
  24. 163 '----------------------------------------------------
  25. 170 'MAPPING SEGMENT FOR BASIC FILES, 07/27/81, JWC
  26. 171 '
  27. 172 '
  28. 180 PRINT CL$:WIDTH 80:LC=0:DR%=0
  29. 190 OPEN"I",2,"A:VARDAT"
  30. 200 PRINT:PRINT:PRINT"ONE MOMENT FOR SETUP PLEASE.......":PRINT
  31. 210 INPUT"DO YOU WANT A PRINT OUT (Y/N) ";PO$
  32. 220 IF PO$="Y" THEN PT$="P" ELSE PT$="N"
  33. 230 NX=80'MAX NUMBER OF VARIABLE CAPACITY
  34. 240 DIM V$(NX),NL%(NX),LL%(NX,NX-10),PA%(NX)
  35. 250 FOR I=1 TO NX:PA%(I)=I:NEXT I
  36. 260 READ NK:DIM K$(NK):DEF FN A$(A)=MID$(STR$(A),2)
  37. 270 FOR I=1 TO NK:READ K$(I):NEXT I
  38. 280 INPUT#2,PN$,I1$,LB!,UB!
  39. 290 PN$="A:"+PN$+".BAS"
  40. 300 OPEN"I",1,PN$
  41. 310 PRINT:PRINT"*** LINES BEING PROCESSED:":
  42. 320 IF EOF(1) THEN 360
  43. 330 S=0:H=0:O=0:IN%=0:Q=0:LINE INPUT#1,L$
  44. 340 GOSUB 740
  45. 350 IF N+32767!<UB! GOTO 320
  46. 360 PRINT:PRINT:PRINT"SORTING VARIABLES....... "
  47. 370 GOSUB 1160
  48. 380 IF PT$="P" THEN GOTO 530 ELSE PRINT:PRINT:INPUT"HIT RETURN WHEN READY FOR LISTING ON CRT ";I$
  49. 390 PRINT:PRINT:PRINT"LIST OF VARIABLES FOR PROGRAM ";PN$:PRINT
  50. 400 FOR I=1 TO NF
  51. 410 PRINT V$(I);TAB(15);"-";
  52. 420 FOR J=0 TO NL%(PA%(I))-1:IF J>0 THEN PRINT", ";
  53. 430 PRINT FNA$(LL%(PA%(I),J)+32767!);
  54. 440 NEXT J
  55. 450 PRINT:PRINT:NEXT I
  56. 460 GOTO 630
  57. 470 CLOSE 1
  58. 480 IF I1$="K" THEN PRINT"KILL '";PN$;"',";DR%:KILL PN$,DR%
  59. 490 IF I1$="P" THEN 530
  60. 500 IF I1$="C" THEN 180
  61. 510 IF I1$<>"END" THEN RUN
  62. 520 CLOSE 2:PRINT:PRINT"*** END OF VARIABLE MAP PROGRAM ***":END
  63. 530 GOSUB 1250:LPRINT TAB(50);"LINES";NL+32767!;"TO";N+32767!:LPRINT:LC=LC+2
  64. 540 FOR I=1 TO NF:LPRINT STR$(I);".";TAB(6);V$(I);TAB(15);"-";:C=0
  65. 550 FOR J=0 TO NL%(PA%(I))-1:IF C THEN LPRINT", ";:ELSE C=-1
  66. 560 IF JMOD13=12 THEN LPRINT:LC=LC+1:LPRINT TAB(15);"-";
  67. 570 LPRINT FNA$(LL%(PA%(I),J)+32767!);
  68. 580 NEXT J
  69. 590 LPRINT:LPRINT:LC=LC+2
  70. 600 IF LC>60 THEN GOSUB 1240:GOSUB 1250:LPRINT:LC=LC+1
  71. 610 NEXT I
  72. 620 IF LC>50 THEN GOSUB 1240:GOSUB 1250:LPRINT:LC=LC+1
  73. 630 IF PT$="P" THEN LPRINT:LPRINT"EQUIVALENT VARIABLES":LC=LC+3
  74. 640 V$="$(!(#(%("
  75. 650 FOR I=0 TO NF-1:FOR J=I+1 TO NF-1
  76. 660 IF LEFT$(V$(I),2)<>LEFT$(V$(J),2) OR LEFT$(V$(I),2)="FN" THEN 700
  77. 670 ON ERROR GOTO 1390
  78. 680 IF(INSTR(V$,RIGHT$(V$(I),2))<>INSTR(V$,RIGHT$(V$(J),2))) OR (INSTR(V$(RIGHT$(V$(I),1))<>INSTR(V$(RIGHT$(V$(J),1))) THEN 700
  79. 690 IF PT$="P" THEN GOSUB 990:LPRINT V$(I);"=";V$(J) ELSE LPRINTV$(I);"=";V$(J):LC=LC+1:EF%=-1
  80. 700 NEXT J:NEXT I
  81. 710 IF NOT EF% THEN IF PT$="P" THEN LPRINT"** NONE FOUND **":LC=LC+1
  82. 720 IF PT$="P" THEN GOSUB 1240
  83. 730 GOTO 470
  84. 731 '
  85. 732 '
  86. 733 '
  87. 734 '-------------------------------------------------------------
  88. 735 'VARIABLE SEARCH SUBROUTINE
  89. 736 '
  90. 737 '
  91. 740 R=0:V=0:X=INSTR(L$," "):N=VAL(LEFT$(L$,X))-32767!:S$=MID$(L$,X+1)
  92. 750 IF N+32767!>UB! THEN RETURN
  93. 760 IF N+32767!<LB! THEN RETURN ELSE PRINT:PRINT L$:PRINT TAB(5);:IF NOT XN% THEN XN%=-1:NL=N
  94. 770 IF LEFT$(S$,1)=" " THEN S$=MID$(S$,2):GOTO 770
  95. 780 IF INSTR(S$,"DATA")=1 THEN RETURN
  96. 790 FOR I=1 TO LEN(S$)
  97. 800 X$=MID$(S$,I,1):X=ASC(X$)
  98. 810 IF NOT S THEN 860
  99. 820 IF H THEN IF(X=>48 AND X<=57) OR (X=>65 AND X<=70) THEN 950 ELSE H=0:S=0:GOTO 860
  100. 830 IF O THEN IF(X=>48 AND X<=57) THEN 950 ELSE O=0:S=0:GOTO 860
  101. 840 IF X=72 AND NOT H THEN H=-1:GOTO 950
  102. 850 IF X=79 AND NOT O THEN O=-1:GOTO 950 ELSE S=0:H=0:O=0
  103. 860 IF X=34 THEN IF Q THEN Q=0:V$="":GOTO 950 ELSE Q=-1:GOTO 950
  104. 870 IF Q THEN 950
  105. 880 IF X=39 THEN RETURN 'REMARK
  106. 890 IF X=38 THEN S=-1:GOTO 950
  107. 900 IF (X=>48 AND X<=57) OR (X=>65 AND X<=90) OR (X=35 OR X=33 OR X=36 OR X=37) THEN IF V THEN V$=V$+X$:GOTO 950 ELSE V$=X$:V=-1:GOTO 950
  108. 910 IF X=40 AND V THEN V$=V$+X$
  109. 920 IF NOT V THEN 950
  110. 930 GOSUB 960:V=0
  111. 940 IF R THEN RETURN
  112. 950 NEXT I:IF NOT V THEN RETURN
  113. 951 '
  114. 952 '
  115. 953 '
  116. 954 '------------------------------------------------------
  117. 955 'KEYWORD COMPARE SUBROUTINE
  118. 956 '
  119. 957 '
  120. 960 IF V$="REM" OR V$="DATA" THEN R=-1:RETURN'SUB ---- 20000
  121. 970 IF VAL(V$)<>0 OR LEFT$(V$,1)="0" THEN V$=MID$(V$,2):GOTO 970
  122. 980 FOR J=1 TO NK:Y=INSTR(V$,K$(J)):IF Y=0 THEN 1030
  123. 990 IF V$=K$(J) THEN RETURN 'KEY WORD
  124. 1000 IF LEFT$(V$,LEN(K$(J)))=K$(J) THEN V$=MID$(V$,LEN(K$(J))+1):GOTO 960
  125. 1010 IF RIGHT$(V$,LEN(K$(J)))=K$(J) THEN V$=MID$(V$,1,LEN(V$)-LEN(K$(J))):GOTO 960
  126. 1020 VH$=MID$(V$,Y+LEN(K$(J))):V$=LEFT$(V$,Y-1):GOSUB 960:IF R THEN RETURN ELSE V$=VH$:GOTO 960
  127. 1030 NEXT J
  128. 1040 IF V$="(" OR V$="" OR V$="!" OR V$="%" OR V$="#" THEN RETURN
  129. 1050 IF IN% THEN PRINT";";:ELSE IN%=-1
  130. 1060 IF NF=0 THEN 1130
  131. 1070 FOR J=0 TO NF
  132. 1080 IF V$<>V$(J) THEN 1110
  133. 1090 IF LL%(J,NL%(J)-1)=N THEN RETURN
  134. 1100 IF NL%(J)<80 THEN LL%(J,NL%(J))=N:NL%(J)=NL%(J)+1:PRINT V$;",<";FNA$(NL%(J));">";:RETURN
  135. 1110 NEXT J
  136. 1120 IF NF=NX-1 THEN PRINT:PRINT"OUT OF ROOM FOR VARIABLES, CONTINUE NEXT RUN...":GOTO 360
  137. 1130 PRINT V$;",[";FNA$(NF+1);"]";
  138. 1140 V$(NF)=V$:LL%(NF,NL%(NF))=N:NL%(NF)=NL%(NF)+1:NF=NF+1
  139. 1150 RETURN
  140. 1151 '
  141. 1152 '
  142. 1153 '
  143. 1154 '-----------------------------------------------------------
  144. 1155 'SORT SUBROUTINE
  145. 1156 '
  146. 1157 '
  147. 1160 DIM H(9):H(1)=1:H(2)=4:H(3)=13:T=1
  148. 1170 IF H(T+2)<5000 THEN T=T+1:H(T+2)=3*H(T+1)+1:GOTO 1170
  149. 1180 IF NF=0 THEN RETURN ELSE FOR T=1 TO 6:IF H(T+2)<NF THEN NEXT
  150. 1190 FOR S=T TO 1 STEP-1:H=H(S):FOR JJ=H TO NF
  151. 1200 V$=V$(JJ):PA%=PA%(JJ):FOR II=JJ-H TO 0 STEP-H
  152. 1210 IF  V$<V$(II) THEN V$(II+H)=V$(II):PA%(II+H)=PA%(II):NEXT
  153. 1220 V$(II+H)=V$:PA%(II+H)=PA%:NEXT JJ,S
  154. 1230 RETURN
  155. 1240 FOR IK=LC TO 65:LPRINT:NEXT IK:LC=0:RETURN
  156. 1250 LPRINT FF$:LPRINT:LPRINT:LPRINT"LIST OF VARIABLES FOR PROGRAM ";PN$;:LC=LC+3:RETURN
  157. 1260 DATA 116
  158. 1270 DATA CONSOLE,RESTORE,SPACE$(,UNLOAD
  159. 1280 DATA LPRINT,DEFDBL,DEFINT,DEFSNG,DEFSTR,DELETE,RESUME,RETURN,RIGHT$
  160. 1290 DATA PRINT,LLIST,INPUT,CLEAR,CLOAD,CLOSE,CSAVE,DSKI$,DSKO$,ERASE
  161. 1300 DATA ERROR,FIELD,FILES,GOSUB,INSTR,LEFT$,MERGE,MOUNT,TROFF,USING
  162. 1310 DATA TRON,CDBL,CHR$,CINT,CONT,CSNG,DSKF,EDIT,ELSE,GOTO,KILL,LINE
  163. 1320 DATA LIST,LOAD,LPOS,LSET,MID$,MKD$,MKI$,MKS$,NAME,NEXT,NULL,OPEN
  164. 1330 DATA PEEK,POKE,READ,RSET,SAVE,SPC,(,STEP,STOP,STR$,SWAP,TAB(,THEN,WAIT
  165. 1340 DATA ABS,AND,ASC,ATN,COS,CVD,CVI,CVS,DEF,DIM,END,EOF,ERL,ERR,EXP,FOR
  166. 1350 DATA FRE,GET,INP,INT,LEN,LET,LOC,LOF,LOG,MOD,NEW,NOT,OUT,POS,PUT,RND
  167. 1360 DATA RUN,SGN,SIN,SQR,TAN,USR,BAL
  168. 1370 DATA AS,IF,TO,ON,OR
  169. 1380 DATA WIDTH,TAB
  170. 1390 IF ERR=13 THEN PRINT:PRINT:PRINT"**** NO VARIABLES FOUND *****":PRINT:GOTO 470
  171. 1400 PRINT"ERROR CODE IS ";ERR;" ON LINE NUMBER ";ERL;:PRINT:END
  172. T:PRINT:PRINT"**** NO VARIABLES FOUND *****":PRINT:GOTO 470
  173. 1400 PR